home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / editdta.arc / EDIT-DTA.BAS next >
Encoding:
BASIC Source File  |  1986-04-18  |  17.8 KB  |  385 lines
  1. 1000 REM $TITLE:'EDIT-DTA/Edit PC-FILE Database/Version 1.3, Apr 14, 1985'
  2. 1010 CLEAR: CLOSE: COLOR 7,0,0: CLS: KEY OFF: SCREEN 0,1,0,0
  3. 1020 ' Maximum field length      =    65
  4. 1030 '         field name length =    12
  5. 1040 '         fields per record =    41 (22)
  6. 1041 '         records/database  = 9,999 (4000)
  7. 1042 ' Compile and link:
  8. 1043 '  SQ33 EDIT-DTA
  9. 1044 '  BASCOM EDIT-DTA/E/S/O/N;
  10. 1045 '  LINK EDIT-DTA+QPRINT6;
  11. 1046 '
  12. 1050 DEFSTR A-H: DEFINT I-Z: OPTION BASE 1
  13. 1060 DIM HDR.NAME(22), HDR.LENGTH%(22), HDR.PTR%(22), INX.RECS$(4001), ST$(22), WE.CE(22), SRCH$(22), SPTR(5)
  14. 1065 '
  15. 1070 ' Initialization
  16. 1072 DEF SEG=0: MON=PEEK(&H410) AND &H30: DEF SEG
  17. 1073 ZA1=&H7: ZA8=&H0E: ZA9=&H0F: SW!=TIMER: ASTOP=CHR$(255)+CHR$(255)
  18. 1074 IF MON=48 THEN MON1=11: MON2=13: ZA8=&HF: ZA9=&H70 ELSE MON1=5: MON2=7
  19. 1076 GOSUB 16210: LOCATE ,,0,MON1,MON2: CLS: ZA1=&H7
  20. 1077 FOR I=1 TO 10: KEY I,"": NEXT I
  21. 1078 ON ERROR GOTO 2010
  22. 1079 ' Restarts from here
  23. 1080 CLOSE: NUM.FIELDS=0: LEN.DTA=1: INX.PTR=0: INX.MAX=4000
  24. 1090 '
  25. 1150 GOSUB 6220  ' Get DTA file name
  26. 1160 GOSUB 7010  ' Load HDR file
  27. 1165 GOSUB 7220  ' Load INX file
  28. 1290 '
  29. 1300 ' Open DTA file for sequential updating
  30. 1320 OPEN DTA.NAME+".DTA" AS #2 LEN=LEN.DTA
  31. 1330  FIELD 2, LEN.DTA AS DTA.RECORD$
  32. 1370 GOSUB 16210: CLS: GOSUB 15090  'Display lines 1&25
  33. 1380 '
  34. 1390 ' Read DTA records in INX sequence
  35. 1400 GOSUB 8020: GET #2,PTR
  36. 1405  AREC=DTA.RECORD$
  37. 1410  IF MID$(AREC,1,1)="/" THEN 1400 ELSE K=1: GOSUB 16210
  38. 1440  GOSUB 15050  'clear line 2
  39. 1446  GOSUB 15020  'Display record number
  40. 1450  FOR J=1 TO NUM.FIELDS
  41. 1470   L=HDR.LENGTH%(J): ST$(J)=LEFT$(MID$(AREC,K,L)+SPACE$(L),L)
  42. 1480   R=J+2: IC=14: ZATR=&H70: TXT$=LEFT$(ST$(J),HDR.LENGTH%(J)): GOSUB 16110
  43. 1490   K=K+HDR.LENGTH%(J)
  44. 1510  NEXT J
  45. 1530  WE.CS=14: WE.RS=3: WE.RE=NUM.FIELDS+2: WE.MODE=0: GOSUB 20000  'Edit the record
  46. 1531  IF K=30 OR K=60 THEN GOSUB 10020: GOTO 1400  'alt-A, add a new record
  47. 1532  IF K=22 OR K=63 THEN 1405  'alt-U, undo changes
  48. 1534  IF WE.CH THEN GOSUB 10260  'modify current record
  49. 1610 GOTO 1400
  50. 1620 GOSUB 4020  'Re-write INX file
  51. 1625 CLOSE: COLOR 7,0,0: CLS
  52. 1630 END
  53. 1640 '
  54. 2000 ' Error handling
  55. 2010 PRINT "Error ";ERR;" occurred at line";ERL: STOP
  56. 3000 '
  57. 3010 ' alt-F = Find a record
  58. 3020 GOSUB 15060: GOSUB 15050: GOSUB 15210  'Clear 2, display field names
  59. 3021 R=2: IC=1: ZATR=&H4: TXT$="Enter FIND data for EXACT match, press Enter when ready:": GOSUB 16110
  60. 3022 FOR J=1 TO NUM.FIELDS
  61. 3024  ST$(J)=SPACE$(HDR.LENGTH%(J))
  62. 3026  R=J+2: IC=14: ZATR=&H70: TXT$=ST$(J): GOSUB 16110
  63. 3028 NEXT J
  64. 3030 WE.CS=14: WE.RS=3: WE.RE=NUM.FIELDS+2: WE.MODE=1: GOSUB 20000  'Edit the arguments
  65. 3043 IF K=22 THEN 3021  'alt-U, undo changes
  66. 3044 IF WE.CH=0 THEN RETURN 'no arguments
  67. 3050 ASRCH="": INX.NXT=0
  68. 3051 FOR I=1 TO NUM.FIELDS: SRCH$(I)=ST$(I): NEXT I  'save criteria
  69. 3052 FOR J=1 TO NUM.FIELDS
  70. 3054  IF SRCH$(J)=SPACE$(HDR.LENGTH%(J)) THEN ASRCH=ASRCH+ASTOP ELSE ASRCH=ASRCH+LEFT$(SRCH$(J),2)
  71. 3056 NEXT J
  72. 3080 '
  73. 3081 ' alt-N = find Next matching record
  74. 3082 WE.MODE=0: IF ASRCH="" THEN 3020  'no previous text
  75. 3109 GOSUB 15060: OLD.PTR=INX.PTR-1  'Clear line 2
  76. 3120 FOR INX.NXT=INX.NXT+1 TO INX.LAST
  77. 3121  AREC=INX.RECS$(INX.NXT)
  78. 3130  FOR I=1 TO LEN.INX-4 STEP 2
  79. 3131   IF MID$(ASRCH,I,2)=ASTOP THEN 3133 ELSE IF MID$(ASRCH,I,2)<>MID$(AREC,I,2) THEN 3140  ' no match
  80. 3133  NEXT I
  81. 3134  INX.PTR=INX.NXT: GOSUB 3210: INX.NXT=INX.PTR: GOSUB 15090: RETURN 1405
  82. 3140 NEXT INX.NXT
  83. 3150 GOSUB 15050: LOCATE 2,1,1,MON1,MON2: COLOR 14,4
  84. 3160 PTXT$="Search field not found. Press enter to continue:": GOSUB 17020: INX.PTR=OLD.PTR: INX.NXT=0
  85. 3170 GOSUB 15090: RETURN
  86. 3200 '
  87. 3205 ' Get exact record match
  88. 3210 GOSUB 8080  'Get data record number ptr
  89. 3220 IF MID$(AREC,1,1)="\" THEN RETURN 3140  'EOF, not found
  90. 3230 IF PTR>0 THEN GET #2,PTR ELSE RETURN 3140
  91. 3240 FOR I=1 TO NUM.FIELDS
  92. 3242  IF MID$(ASRCH,(I*2)-1,2)=ASTOP THEN 3248
  93. 3243  FOR K=HDR.LENGTH%(I) TO 1 STEP -1: IF MID$(SRCH$(I),K,1)=" " THEN NEXT K
  94. 3244  IF LEFT$(SRCH$(I),K)<>MID$(DTA.RECORD$,HDR.PTR%(I),K) THEN RETURN 3140
  95. 3248 NEXT I
  96. 3250 RETURN
  97. 4000 '
  98. 4010 ' Re-write INX file if any changes
  99. 4020 IF INX.CHANGE=0 THEN RETURN
  100. 4025 LOCATE 17,10,0: PRINT "Re-writing INX file. Stand-by."
  101. 4030 FOR INX.PTR=1 TO INX.LAST
  102. 4040  LSET INX.RECORD$=INX.RECS$(INX.PTR)
  103. 4050  PUT #1,INX.PTR
  104. 4060 NEXT INX.PTR
  105. 4070 RETURN
  106. 5000 '
  107. 5010 ' alt-H = display key help
  108. 5020 GOSUB 16210: CLS: IC=1: RESTORE 21001
  109. 5030 FOR R=1 TO 24: READ ZATR,TXT$: TXT$=LEFT$(TXT$+SPACE$(79),79): GOSUB 16110: NEXT R
  110. 5040 LOCATE 25,1: COLOR 15,1: PTXT$="Press any key to continue:": GOSUB 17030
  111. 5050 GOSUB 16220: CLS: RETURN
  112. 6200 '
  113. 6210 ' Get command line parameters or ask for DTA name
  114. 6220 IF SW!<>0 OR SW.PARM=2 THEN DTA.NAME="": GOTO 6260
  115. 6225 DEF SEG: DEF USR0=VARPTR(SPTR(1))
  116. 6230 SPTR(1)=&H5B59: SPTR(2)=&H5153: SPTR(3)=&HEB83: SPTR(4)=&HCB10
  117. 6240 I=0: PSP=USR0(I): DEF SEG=PSP: L=PEEK(&H80): DTA.NAME=""
  118. 6250 FOR I=2 TO L: DTA.NAME=DTA.NAME+CHR$(PEEK(&H80+I)): NEXT: DEF SEG
  119. 6251 IF INSTR(DTA.NAME,"/3") THEN VERSION=3: DTA.NAME=LEFT$(DTA.NAME,INSTR(DTA.NAME,"/3"))
  120. 6260 RESTORE 21001: GOSUB 16210: CLS: IC=1  'Display titles
  121. 6261 FOR R=1 TO 3: READ ZATR,TXT$: TXT$=LEFT$(TXT$+SPACE$(79),79): GOSUB 16110: NEXT R
  122. 6262 COLOR 2,0: IF DTA.NAME="" THEN LOCATE 4,1: INPUT;"Enter database name (without extension)";DTA.NAME: PRINT ELSE SW.PARM=1
  123. 6270 IF INSTR(DTA.NAME,".")>0 THEN RUN
  124. 6280 FOR I=1 TO LEN(DTA.NAME): MID$(DTA.NAME,I,1)=CHR$(ASC(MID$(DTA.NAME,I,1)) + 32*(MID$(DTA.NAME,I,1)>"Z")): NEXT
  125. 6290 RETURN
  126. 7000 '
  127. 7001 ' Load HDR file for FIELD definitions
  128. 7010 LOCATE 6,1,0: PRINT "Loading HDR file": I=0
  129. 7015 OPEN DTA.NAME+".HDR" FOR INPUT AS #1
  130. 7020 WHILE NOT EOF (1)
  131. 7030  LINE INPUT #1,ANAME: LINE INPUT #1,ALENGTH
  132. 7040  I=I+1: IF I>22 THEN 7080 ELSE L=VAL(ALENGTH): HDR.LENGTH%(I)=L
  133. 7045  HDR.PTR%(I)=LEN.DTA: LEN.DTA=LEN.DTA+L
  134. 7050  WE.CE(I)=L+13
  135. 7060  HDR.NAME(I)=LEFT$(ANAME+SPACE$(12),12)
  136. 7070 WEND
  137. 7080 CLOSE #1
  138. 7090 NUM.FIELDS=I
  139. 7100 LEN.INX=(NUM.FIELDS*2)+4+(2*(VERSION=3)): COLOR 2,0
  140. 7101 ' Determine which version of PC-FILE
  141. 7102 OPEN DTA.NAME+".INX" AS #1 LEN=LEN.INX
  142. 7103  FIELD 1, LEN.INX AS INX.RECORD$
  143. 7104 GET 1: ANX=MID$(INX.RECORD$,(NUM.FIELDS*2)+1,4): CLOSE #1
  144. 7105 FOR J=1 TO 4: IF MID$(ANX,J,1)<"0" OR MID$(ANX,J,1)>"9" THEN VERSION=3:          LEN.INX=LEN.INX-2   ELSE NEXT
  145. 7110 PRINT "Number of fields per record:";I
  146. 7120 PRINT "Length of data records:     ";LEN.DTA
  147. 7130 PRINT "Length of index records:    ";LEN.INX
  148. 7135 IF NUM.FIELDS=0 OR NUM.FIELDS>22 THEN PRINT "Too many FIELDs, 22 maximum.": BEEP: GOTO 1625
  149. 7140 RETURN
  150. 7200 '
  151. 7210 ' Load INX file, DTA file record pointers
  152. 7220 PRINT: PRINT "Loading INX file";
  153. 7230 OPEN DTA.NAME+".INX" AS #1 LEN=LEN.INX
  154. 7240  FIELD 1, LEN.INX AS INX.RECORD$
  155. 7250 FOR INX.PTR=1 TO INX.MAX
  156. 7260  GET #1: INX.RECS$(INX.PTR)=INX.RECORD$: LOCATE ,18: PRINT INX.PTR-1;
  157. 7270  IF LEFT$(INX.RECORD$,1)="\" THEN INX.LAST=INX.PTR: GOTO 7290
  158. 7280 NEXT INX.PTR
  159. 7290 PRINT: IF INX.LAST=0 THEN PRINT "Too many records, 4000 is maximum.": BEEP: GOTO 1625
  160. 7300 PRINT "Records in database:        ";INX.LAST-1;TAB(40);FRE("");" bytes free."
  161. 7310 IF SW.PARM=0 THEN GOSUB 5040
  162. 7320 INX.PTR=0: RETURN
  163. 8000 '
  164. 8010 ' Get pointer to next data record
  165. 8020 INX.PTR=INX.PTR+1
  166. 8030 GOSUB 8080        ' next index record
  167. 8040 IF MID$(AREC,1,1)="\" THEN GOSUB 9020
  168. 8050 IF LEFT$(AREC,1)="/" THEN 8020
  169. 8051 IF PTR=0 THEN 8020
  170. 8055 RETURN
  171. 8060 '
  172. 8070 ' Get pointer to specific record
  173. 8080 AREC=INX.RECS$(INX.PTR)
  174. 8085 IF VERSION<>3 THEN PTR=VAL(MID$(AREC,(NUM.FIELDS*2)+1,4)): RETURN
  175. 8087 PTR=CVI(MID$(AREC,(NUM.FIELDS*2)+1,2)): RETURN
  176. 8090 '
  177. 8100 ' Back up one record
  178. 8110 FOR N=1 TO 2
  179. 8120  IF INX.PTR>1 THEN INX.PTR=INX.PTR-1: GOSUB 8080 ELSE INX.PTR=0: RETURN
  180. 8130  IF MID$(AREC,1,1)="/" OR PTR=0 THEN 8120
  181. 8140 NEXT N: RETURN
  182. 8150 '
  183. 8160 ' ^PgDn - Position to last record
  184. 8170 INX.PTR=INX.LAST: GOSUB 8110: RETURN
  185. 9000 '
  186. 9010 ' Present end of job menu
  187. 9020 RESTORE 9902: GOSUB 15010
  188. 9050 FOR R=2 TO 15: READ IC,TXT$: ZATR=&H2: GOSUB 16110: NEXT R
  189. 9060 LOCATE 13,23,1,MON1,MON2: GOSUB 17040
  190. 9070 I=INSTR("EFLCA",ANS): IF I=0 THEN BEEP: GOTO 9060
  191. 9080 ON I GOTO 9100,9200,9300,9400,9500
  192. 9100 RETURN 1620  'End
  193. 9200 INX.PTR=0: RETURN 1370   'Restart from first
  194. 9300 GOSUB 8170: RETURN 1370  'Restart from last
  195. 9400 GOSUB 4020: SW.PARM=2: RETURN 1080 'Change database
  196. 9500 GOTO 10020   'Add record
  197. 9900 '
  198. 9902 DATA 10,""
  199. 9903 DATA 10,"You have reached the end of the database,"
  200. 9904 DATA 10,""
  201. 9905 DATA 10,"Select one of the following functions:"
  202. 9906 DATA 10,""
  203. 9907 DATA 20,"E = End, return to system"
  204. 9908 DATA 20,"F = Restart from first record"
  205. 9909 DATA 20,"L = Restart from last record"
  206. 9910 DATA 20,"C = Change to another database"
  207. 9911 DATA 20,"A = Add a new record"
  208. 9912 DATA 10,""
  209. 9913 DATA 10,"Enter choice:"
  210. 9914 DATA 10,""
  211. 9915 DATA 10,""
  212. 10000 '
  213. 10010 ' alt-A = add a record
  214. 10020 INX.PTR=INX.LAST: GOSUB 15020: GOSUB 15100: GOSUB 15060 'Ask for data, display recno
  215. 10030 AREC=SPACE$(LEN.DTA)
  216. 10040 FOR J=1 TO NUM.FIELDS  'Display blank form
  217. 10050  ST$(J)=LEFT$(MID$(AREC,K,HDR.LENGTH%(J))+SPACE$(65),65)
  218. 10060  R=J+2: IC=14: ZATR=&H70: TXT$=LEFT$(ST$(J),HDR.LENGTH%(J)): GOSUB 16110
  219. 10070  K=K+HDR.LENGTH%(J)
  220. 10080 NEXT J
  221. 10090 WE.CS=14: WE.RS=3: WE.RE=NUM.FIELDS+2: WE.MODE=2: GOSUB 20000  'Edit the record
  222. 10100 IF K=27 THEN 10130
  223. 10110 IF K=22 OR K=63 THEN 10030  'alt-U, undo new record
  224. 10120 IF WE.CH THEN GOSUB 10220: GOTO 10020  'modify current record
  225. 10130 GOSUB 8170: GOSUB 15120: RETURN
  226. 10200 '
  227. 10210 ' Add a new record
  228. 10220 INX.RECS$(INX.LAST+1)=INX.RECS$(INX.LAST)  'Set new EOF record
  229. 10230 IF VERSION=3 THEN INX.RECS$(INX.LAST)=SPACE$(LEN.INX-4)+MKI$(INX.LAST):          GOTO 10240
  230. 10235 INX.RECS$(INX.LAST)=SPACE$(LEN.INX-4)+RIGHT$("0000"+MID$(STR$(INX.LAST),2),4)
  231. 10240 PTR=INX.LAST: INX.PTR=INX.LAST: INX.LAST=INX.LAST+1
  232. 10245 '
  233. 10250 ' Modify a record
  234. 10260 AREC=""
  235. 10270 FOR J=1 TO NUM.FIELDS: AREC=AREC+LEFT$(ST$(J),HDR.LENGTH%(J)): NEXT J
  236. 10280 LSET DTA.RECORD$=AREC: PUT #2,PTR
  237. 10290 INX.CHANGE=1: AREC=""
  238. 10300 FOR J=1 TO NUM.FIELDS: AREC=AREC+LEFT$(ST$(J),2): NEXT J
  239. 10310 MID$(INX.RECS$(INX.PTR),1,LEN(AREC))=AREC: RETURN
  240. 11000 '
  241. 11010 ' alt-D = Delete current record
  242. 11020 GOSUB 15060: LOCATE 2,1: PTXT$="Delete record? (Y/N)": GOSUB 17030
  243. 11030 IF ANS<>"Y" THEN RETURN
  244. 11040 MID$(INX.RECS$(INX.PTR),1,1)="/": INX.CHANGE=1
  245. 11050 LSET DTA.RECORD$=STRING$(LEN.DTA,"/"): PUT #2,PTR
  246. 11060 INX.PTR=INX.PTR-2: RETURN
  247. 15000 '
  248. 15001 ' Display messages
  249. 15010 FOR R=2 TO 25: GOSUB 16090: NEXT: RETURN  'Clear lines 2 thru 25
  250. 15020 IF INX.PTR>=INX.LAST-1 THEN A=" (last)" ELSE A=SPACE$(7)
  251. 15030 R=1: IC=1: ZATR=&H0F: TXT$="Record #"+LEFT$(STR$(INX.PTR)+SPACE$(9),9)+A+" "
  252. 15040 GOSUB 16110: RETURN
  253. 15050 R=2:  GOSUB 16090: RETURN  'Clear line 2
  254. 15060 R=25: GOSUB 16090: RETURN  'Clear line 25
  255. 15070 R=1: IC=26: ZATR=&H0F: TXT$="Data Base - "+LEFT$(DTA.NAME+SPACE$(17),17): GOSUB 16110
  256. 15080 IC=50: TXT$="Date "+DATE$+"  Time "+TIME$: GOSUB 16110: RETURN
  257. 15090 GOSUB 15070: GOSUB 15120: GOSUB 15210: RETURN 'Restore 1,25, field titles
  258. 15100 R=2: IC=1: ZATR=&H4: TXT$="Keys: PgDn accepts new record, Enter skips to next field, ESCape stops adding": GOSUB 16110: RETURN
  259. 15105 '
  260. 15110 ' Display line 25 key info
  261. 15120 GOSUB 15060: RESTORE 15170
  262. 15130 FOR I=1 TO 10
  263. 15140  TXT$=RIGHT$(STR$(I),1): ZATR=ZA8: GOSUB 16110
  264. 15150  READ TXT$: TXT$=LEFT$(TXT$+"   ",6): IC=IC+1: ZATR=ZA9: GOSUB 16110: IC=IC+7
  265. 15160 NEXT I: ZATR=ZA1: RETURN
  266. 15170 DATA "Help","Add","Prev","Next","Undo","Delete","      ","Find","Again","Quit"
  267. 15200 ' Display field names
  268. 15210 FOR J=1 TO NUM.FIELDS
  269. 15215 'ZATR=&H79 ...
  270. 15220  ZATR=&H01: IC=1: R=J+2: TXT$=HDR.NAME(J)+"╟": GOSUB 16110: ZATR=&H70
  271. 15230  IC=14: TXT$=SPACE$(HDR.LENGTH%(J)): GOSUB 16110
  272. 15240 NEXT J
  273. 15250 RETURN
  274. 16000 '
  275. 16010 ' Monitor display and COLOR routines
  276. 16090 IC=1: ZATR=&H7: TXT$=SPACE$(79): GOSUB 16110: RETURN 'Clear a line
  277. 16100 ' Display a line or message
  278. 16110 IF SW!=0 THEN CALL QPRINT(TXT$,R,IC,ZATR): RETURN
  279. 16120 ZM=ZATR\16: COLOR ZATR-(ZM*16),ZM
  280. 16130 R4=CSRLIN: ZM=POS(0): LOCATE R,IC,0: PRINT TXT$;: LOCATE R4,ZM: RETURN
  281. 16200 ' Set COLORs subroutines
  282. 16210 COLOR 7,0,1: ZATR=&H7: RETURN  'Normal colors, wh/blue
  283. 16220 COLOR 15,0,1: ZATR=&HF: RETURN
  284. 17000 '
  285. 17010 ' Get console replies
  286. 17020 BEEP
  287. 17030 COLOR 4,0: PRINT PTXT$;: COLOR 7,0
  288. 17040 LOCATE ,,1: GOSUB 16220: ANS=INPUT$(1): LOCATE ,,0
  289. 17050 IF ANS>"Z" THEN ANS=CHR$(ASC(ANS)-32)
  290. 17060 RETURN
  291. 20000 '
  292. 20010 ' Window Editor
  293. 20011 '  WE.MODE = 0 for list, 1 for find, 2 for add
  294. 20020 R=WE.RS: IC=WE.CS: WE.INS=0: GOSUB 20590: WE.CH=0
  295. 20030 LOCATE R,IC,1: IF WE.INS THEN LOCATE ,,,1,MON2 ELSE LOCATE ,,,MON1,MON2
  296. 20040 A=INKEY$: IF A="" THEN 20040 ELSE LOCATE ,,0
  297. 20050 WE.R=R-WE.RS+1: WE.C=IC-WE.CS+1: SLINE=WE.R: SCOL=WE.C
  298. 20060 IF LEN(A)>1 THEN 20110 ELSE K=ASC(A)
  299. 20070  IF K=13 THEN IF WE.MODE=2 THEN IC=WE.CS: R=R+1: WE.INS=0: GOTO 20530 ELSE 20200
  300. 20080  IF K=27 THEN IF WE.MODE=2 THEN RETURN ELSE GOTO 20190
  301. 20085  WE.CH=1
  302. 20090  IF K=8 THEN IF IC>WE.CS THEN IC1=WE.C-1: IC=IC-1: GOTO 20470 ELSE IC1=1: GOTO 20470
  303. 20100  IF R<WE.RS OR R>WE.RE OR IC<WE.CS OR IC>WE.CE(SLINE) THEN 20150 ELSE 20500
  304. 20110 K=ASC(MID$(A,2,1)): SC=INSTR(AXC$,CHR$(K))
  305. 20115 IF WE.MODE=2 AND (K>58 AND K<69) THEN 20150 'no F keys while adding
  306. 20120 IF K>58 AND K<69 THEN ON K-58 GOTO 20160,20170,20330,20200,20200,20230,20150,20240,20250,20190
  307. 20130 ON SC GOTO 20270,20280,20330,20290,20440,20430,20300,20200,20310,20460,20360,20410,20450,20210,20320,20220,20230,20240,20250,20260,20160,20170,20180,20190
  308. 20140 '
  309. 20150 SOUND 420,.42: GOTO 20030     'undefined keys
  310. 20160 GOSUB 5020: GOSUB 15090       'alt-H, display Help
  311. 20165 INX.PTR=INX.PTR+1: GOTO 20330
  312. 20170 BEEP: RETURN                  'alt-A, add a record
  313. 20180 BEEP: RETURN                  'alt-S, search
  314. 20190 GOTO 9020                     'alt-Q, Quit
  315. 20200 RETURN                        'PgDn, return with k=81
  316. 20210 GOSUB 8170: RETURN 1400       'Ctrl-PgDn, set to last record
  317. 20220 INX.PTR=0: INX.NXT=0: GOTO 20340  'Ctrl-PgUp, set to first record
  318. 20230 GOSUB 11020: GOSUB 15120: GOTO 20340 'alt-D, delete current record
  319. 20240 GOSUB 3010: GOTO 20340        'alt-F, find a record
  320. 20250 GOSUB 3082: GOTO 20340        'alt-N, find next record
  321. 20260 RETURN                        'alt-U, return with k=22
  322. 20270 IC=WE.CS: GOTO 20030          'Home, col 1
  323. 20280 R=R-1: GOTO 20530             'up
  324. 20290 IC=IC-1: GOTO 20530           'left
  325. 20300 R=R+1: GOTO 20530             'down
  326. 20310 WE.INS=NOT WE.INS: GOTO 20530 'Ins
  327. 20320 R=WE.RS: IC=WE.CS: GOTO 20030 '^home
  328. 20330 IF INX.PTR>1 THEN GOSUB 8110  'PgUp, back up one record
  329. 20340 IF WE.MODE=1 THEN BEEP: GOTO 20030 ELSE RETURN 1400
  330. 20350 '
  331. 20360 GOSUB 20370: IC=SCOL+WE.CS-1: GOTO 20030 '^left
  332. 20370 FOR I=SCOL TO 1 STEP -1: IF MID$(ST$(SLINE),I,1)<>" " THEN NEXT I
  333. 20380 FOR J=I-1 TO 1 STEP -1: IF MID$(ST$(SLINE),J,1)<>" " THEN NEXT J
  334. 20390 FOR K=J-1 TO 1 STEP -1: IF MID$(ST$(SLINE),K,1)=" " THEN SCOL=K+1: RETURN ELSE NEXT K
  335. 20400 SCOL=1: RETURN
  336. 20410 I=INSTR(MID$(ST$(SLINE),SCOL)," "): IF I>0 THEN SCOL=I+SCOL  '^right
  337. 20420 IC=SCOL+WE.CS-1: GOTO 20030
  338. 20430 FOR IC=WE.CE(SLINE) TO WE.CS STEP -1: IF MID$(ST$(WE.R),IC-WE.CS+1,1)=" " THEN NEXT IC
  339. 20435 IF IC=WE.CE(SLINE) THEN 20530
  340. 20440 IC=IC+1: GOTO 20530  'right
  341. 20450 MID$(ST$(WE.R),WE.C)=SPACE$(WE.CE(SLINE)-IC+1): GOTO 20490 '^END
  342. 20460 IC1=WE.C  'del
  343. 20470 MID$(ST$(WE.R),IC1,WE.CE(SLINE)-IC1+1)=MID$(ST$(WE.R),IC1+1,WE.CE(SLINE)-IC1)+" "
  344. 20480 '
  345. 20490 SWAP WE.CS,IC: TXT$=ST$(WE.R): GOSUB 16110: SWAP WE.CS,IC: GOTO 20520
  346. 20500 IF WE.INS THEN MID$(ST$(WE.R),WE.C,WE.CE(SLINE)-WE.C)=A+MID$(ST$(WE.R),WE.C,WE.CE(SLINE)-WE.C): IC=IC+1: GOTO 20490
  347. 20510 MID$(ST$(WE.R),WE.C,1)=A: TXT$=A: GOSUB 16110: IC=IC+1
  348. 20520 WE.CH=1
  349. 20530 IF IC<WE.CS THEN R=R-1: IC=WE.CE(SLINE)
  350. 20540 IF IC>WE.CE(SLINE) THEN R=R+1: IC=WE.CS
  351. 20550 IF R<WE.RS THEN R=WE.RE
  352. 20560 IF R>WE.RE THEN R=WE.RS
  353. 20570 GOTO 20030
  354. 20580 ' Restore control key table
  355. 20590 RESTORE 20610: AXC$=""
  356. 20600 READ SC: IF SC<>999 THEN AXC$=AXC$+CHR$(SC): GOTO 20600 ELSE RETURN
  357. 20610 DATA 71,72,73,75,77,79,80,81,82,83,115,116,117,118,119,132,32,33,49,22,35,30,31,16,999
  358. 21000 '
  359. 21001 DATA 11,"EDIT-DTA              Edit PC-FILE Database                V1.3       14 Apr 85"
  360. 21002 DATA 9,"                         by Vernon Buerg
  361. 21003 DATA 2,""
  362. 21004 DATA 2,"  This program allows you to edit database files which were created by PC-FILE."
  363. 21005 DATA 2,"  That is, you may Add, Delete, or Change records in the database files.  This"
  364. 21006 DATA 2,"  program currently allows a maximum of 22 fields and 4000 data records."
  365. 21007 DATA 2,""
  366. 21008 DATA 2,"  Records are presented one at a time. You may press Enter to continue to the"
  367. 21009 DATA 2,"  next record, or you may use the cursor positioning and other keys to edit a"
  368. 21010 DATA 2,"  record or perform a special function. "
  369. 21011 DATA 2,""
  370. 21012 DATA 10,"                      Editing and Positioning keys"
  371. 21013 DATA 2,"ESCape = quit, return to system       Enter  = accept changes"
  372. 21014 DATA 2,"HOME   = position to column 1         ^HOME  = position to line 1, col 1"
  373. 21015 DATA 2,"END    = position to last char        ^END   = delete from cursor
  374. 21016 DATA 2,"^right = next word                    ^left  = previous word"
  375. 21017 DATA 2,""
  376. 21018 DATA 2,"F1   alt-H  = Help, display keys      F2   alt-A  = add a new record"
  377. 21019 DATA 2,"F3   PgUp   = previous record         F4   PgDn   = next record"
  378. 21020 DATA 2,"F5   alt-U  = Undo edit changes       F6   alt-D  = Delete current record"
  379. 21021 DATA 2,"F7   alt-S  = Search (future)         F8   alt-F  = Find a record"
  380. 21022 DATA 2,"F9   alt-N  = find Next record        F10  alt-Q  = Quit, return to system"
  381. 21023 DATA 2,"a-F3 ^PgUp  = top, first record       a-F4 ^PgDn  = bottom, last record"
  382. 21024 DATA 2,""
  383. 21025 DATA 2,""
  384. 21026 '       ....,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8
  385.